home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / BATTERY.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-27  |  6.9 KB  |  289 lines
  1. 10  'BATTERY - 23 MAR 94 rev. 27 SEP 96
  2. 20  CLS:KEY OFF
  3. 30  IF EX$=""THEN EX$="EXIT"
  4. 40  ON ERROR GOTO 240
  5. 50  COLOR 7,0,1
  6. 60  NA$="BATTERY.DAT"
  7. 70  UL$=STRING$(80,205)
  8. 80  DIM A$(128,5),F$(50,2)
  9. 90  DIM B$(9)
  10. 100  '
  11. 110  DATA #44/76/G13
  12. 120  DATA 6v lantern - screw term.
  13. 130  DATA 6v lantern - spring term.
  14. 140  DATA 9v,AAA,AA,C,D,OTHER
  15. 150  FOR I=1 TO 9:READ B$(I):NEXT I
  16. 160  '
  17. 170  '.....start
  18. 180  COLOR 15,2
  19. 190  PRINT " BATTERY SCHEDULE";TAB(57);"by George Murphy VE3ERP ";
  20. 200  COLOR 1,0:PRINT STRING$(80,223);
  21. 210  COLOR 7,0
  22. 220  GOTO 540
  23. 230  '
  24. 240  '.....error trap
  25. 250  IF ERR=53 AND ERL=550 THEN 280
  26. 260  CLS:PRINT "Error";ERR;"in line";ERL:END
  27. 270  '
  28. 280  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 4
  29. 290  PRINT " Your battery data will be contained in a file named ";NA$;"."
  30. 300  PRINT
  31. 310  PRINT" No battery data has yet been entered so the file does not yet exist."
  32. 320  PRINT
  33. 330  PRINT " The file will be created automatically ";
  34. 340  PRINT "as soon as you enter your first data."
  35. 350  PRINT
  36. 360  PRINT " The file can be edited or deleted at any time."
  37. 370  PRINT
  38. 380  PRINT " If you do not want to start the file now the program will return ";
  39. 390  PRINT "to the last"
  40. 400  PRINT " previous menu."
  41. 410  PRINT:COLOR 15,0
  42. 420  PRINT " Do you want to create the file and start entering battery ";
  43. 430  PRINT "data now?";
  44. 440  COLOR 0,7
  45. 450  PRINT " (y/n) "
  46. 460  Z$=INKEY$
  47. 470  COLOR 7,0
  48. 480  IF Z$="N"OR Z$="n"THEN CLS:RUN EX$
  49. 490  IF Z$="Y"OR Z$="y"THEN CLS:GOTO 1700
  50. 500  GOTO 460
  51. 510  OPEN"O",1,"\data\batt\"+NA$
  52. 520  CLOSE
  53. 530  '
  54. 540  '.....load file
  55. 550  OPEN "I",1,"\data\batt\"+NA$
  56. 560  N=0
  57. 570  IF EOF(1)THEN 610
  58. 580  N=N+1:FOR Y=1 TO 5
  59. 590  INPUT# 1,A$(N,Y):NEXT Y
  60. 600  GOTO 570
  61. 610  CLOSE
  62. 620  '
  63. 630  '.....main menu
  64. 640  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  65. 650  PRINT TAB(8);
  66. 660  PRINT "This program compiles an inventory of all your battery operated"
  67. 670  PRINT TAB(8);
  68. 680  PRINT "devices, lists the quantity and type of batteries in each device"
  69. 690  PRINT TAB(8);
  70. 700  PRINT "and records the date when the batteries were last changed."
  71. 710  PRINT
  72. 720  PRINT TAB(8);
  73. 730  PRINT "When you change batteries don't always throw the old ones away."
  74. 740  PRINT TAB(8);
  75. 750  PRINT "Most clocks will run for months on batteries that are too weak"
  76. 760  PRINT TAB(8);
  77. 770  PRINT "for anything else."
  78. 780  LOCATE 11,1
  79. 790  PRINT UL$;
  80. 800  PRINT " Press number in < > to:";
  81. 810  PRINT UL$;
  82. 820  PRINT "   < 1 >  ADD a listing"
  83. 830  PRINT "   < 2 >  EDIT or DELETE a listing"
  84. 840  PRINT "   < 3 >  DISPLAY/PRINT listings"
  85. 850  PRINT "   < 4 >  DELETE entire file ";:COLOR 12,0:PRINT "( CAUTION ! )"
  86. 860  COLOR 7,0
  87. 870  PRINT UL$;
  88. 880  PRINT "   < 0 >  EXIT"
  89. 890  Z$=INKEY$:IF Z$=""THEN 890
  90. 900  IF Z$="0"THEN CLS:RUN EX$
  91. 910  IF ASC(Z$)<49 OR ASC(Z$)>52 THEN 890
  92. 920  IF Z$="1"THEN CLS:GOTO 1700
  93. 930  IF Z$="2"THEN CLS:GOTO 2350
  94. 940  IF Z$="3"THEN 990
  95. 950  IF Z$="4"THEN CLS:GOTO 1120
  96. 960  GOTO 890
  97. 970  '
  98. 980  '.....sort options
  99. 990  LOCATE 12,24:PRINT " sort listings by:
  100. 1000  VIEW PRINT 14 TO 24:CLS:VIEW PRINT:LOCATE 14
  101. 1010  PRINT "       < 5 >  DEVICE"
  102. 1020  PRINT "       < 6 >  BATTERY type"
  103. 1030  PRINT "       < 7 >  DATE of last replacement"
  104. 1040  PRINT UL$;
  105. 1050  Z$=INKEY$:IF Z$=""THEN 1050
  106. 1060  IF ASC(Z$)<53 OR ASC(Z$)>55 THEN 1050
  107. 1070  IF Z$="5"THEN ST=0:GOSUB 1770:GOTO 2000
  108. 1080  IF Z$="6"THEN ST=1:GOSUB 1770:GOTO 2000
  109. 1090  IF Z$="7"THEN ST=2:GOSUB 1770:GOTO 2000
  110. 1100  GOTO 1050
  111. 1110  '
  112. 1120  '.....delete file
  113. 1130  BEEP
  114. 1140  LOCATE 13,10:COLOR 15,0
  115. 1150  PRINT "      ARE YOU SURE YOU WANT TO DELETE ENTIRE FILE ? ";
  116. 1160  COLOR 14,6:PRINT " y/n ":COLOR 7,0
  117. 1170  Z$=INKEY$
  118. 1180  IF Z$="n"THEN CLS:GOTO 170
  119. 1190  IF Z$="y"THEN CLS:GOTO 1210
  120. 1200  GOTO 1170
  121. 1210  KILL"\data\batt\battery.dat"
  122. 1220  CLS:RUN EX$
  123. 1230  '
  124. 1240  '.....sort & save data
  125. 1250  ST=0:GOSUB 1770      'sort by device
  126. 1260  OPEN "O",1,"\data\batt\"+NA$
  127. 1270  FOR Z=1 TO N
  128. 1280  WRITE# 1,A$(Z,1),A$(Z,2),A$(Z,3),A$(Z,4),A$(Z,5)
  129. 1290  NEXT Z
  130. 1300  CLOSE
  131. 1310  GOTO 170
  132. 1320  '
  133. 1330  '.....convert to upper case
  134. 1340  FOR U=1 TO LEN(I$):V=ASC(MID$(I$,U,1)):IF V=44 THEN RETURN
  135. 1350  IF V>96 AND V<123 THEN MID$(I$,U,1)=CHR$(V-32)
  136. 1360  NEXT U:RETURN
  137. 1370  '
  138. 1380  '.....inputs
  139. 1390  LINE INPUT " ENTER: Device category (e.g. clock, radio etc.).....? ";I$
  140. 1400  GOSUB 1330:RETURN
  141. 1410  '
  142. 1420  LINE INPUT " ENTER: Device further description/location..........? ";I$
  143. 1430  RETURN
  144. 1440  '
  145. 1450  LINE INPUT " ENTER: Number of batteries in device............... ? ";I$
  146. 1460  RETURN
  147. 1470  '
  148. 1480  '.....battery description
  149. 1490  PRINT UL$;
  150. 1500  PRINT " Press number in < > to select battery:"
  151. 1510  PRINT UL$;
  152. 1520  FOR J=1 TO 9
  153. 1530  PRINT " <";J;">  ";B$(J)
  154. 1540  NEXT J
  155. 1550  PRINT UL$;
  156. 1560  Z$=INKEY$:IF VAL(Z$)=0 THEN 1560
  157. 1570  I$=B$(VAL(Z$)):GOTO 1590
  158. 1580  GOTO 1560
  159. 1590  LN=CSRLIN-13
  160. 1600  VIEW PRINT LN TO 24:CLS:VIEW PRINT
  161. 1610  IF Z$="9" THEN 1630
  162. 1620  LOCATE LN,9:PRINT I$:GOTO 1650
  163. 1630  LOCATE LN
  164. 1640  LINE INPUT " ENTER: Battery size or description................. ? ";I$
  165. 1650  RETURN
  166. 1660  '
  167. 1670  LINE INPUT " ENTER: Date current batteries installed (yy/mm).... ? ";I$
  168. 1680  RETURN
  169. 1690  '
  170. 1700  '.....new listing
  171. 1710  N=N+1
  172. 1720  PRINT " NEW LISTING"
  173. 1730  PRINT UL$;
  174. 1740  FOR Z=1 TO 5:ON Z GOSUB 1390,1420,1450,1480,1670:A$(N,Z)=I$
  175. 1750  NEXT Z:Z=N:CLS:GOTO 2390
  176. 1760  '
  177. 1770  '.....sort
  178. 1780  CLS
  179. 1790  SN=N:SM=SN
  180. 1800  SM=INT(SM/2):IF SM=0 THEN 1980
  181. 1810  SK=SN-SM:SJ=1
  182. 1820  SI=SJ
  183. 1830  SL=SI+SM
  184. 1840  IF ST=0 THEN 1870
  185. 1850  IF ST=1 THEN 1890
  186. 1860  IF ST=2 THEN 1910
  187. 1870  SORT1$=A$(SI,1)+A$(SI,2)
  188. 1880   SORT2$=A$(SL,1)+A$(SL,2):GOTO 1930   'sort by device
  189. 1890  SORT1$=A$(SI,4)+A$(SI,1)
  190. 1900   SORT2$=A$(SL,4)+A$(SL,1):GOTO 1930   'sort by battery
  191. 1910  SORT1$=A$(SL,5)+A$(SL,1)
  192. 1920   SORT2$=A$(SI,5)+A$(SI,1):GOTO 1930   'sort by date
  193. 1930  IF SORT1$<=SORT2$ THEN 1960
  194. 1940  FOR X=1 TO 5:SWAP A$(SI,X),A$(SL,X):NEXT X
  195. 1950  SI=SI-SM:IF SI>0 THEN 1830
  196. 1960  SJ=SJ+1:IF SJ>SK THEN 1800
  197. 1970  GOTO 1820
  198. 1980  RETURN
  199. 1990  '
  200. 2000  '.....screen print
  201. 2010  PRINT UL$;
  202. 2020  PRINT TAB(24);" B A T T E R Y   S C H E D U L E "
  203. 2030  PRINT UL$;
  204. 2040  LOCATE CSRLIN-1,8:PRINT "<0xCB!>"
  205. 2050  PRINT " sort# OPEN DEVICE ";
  206. 2060  PRINT SPC(6);"(Year and month shown are date of last replacement)
  207. 2070  PRINT UL$;
  208. 2080  LOCATE CSRLIN-1,8:PRINT "LOCATE"
  209. 2090  FOR Z=1 TO N
  210. 2100  N$=STR$(Z)
  211. 2110  IF LEN(N$)<4 THEN N$=" "+N$:GOTO 2110
  212. 2120  PRINT N$;":    ";                       'sort number
  213. 2130   IF ST=0 THEN COLOR 15,1 ELSE COLOR 7,0
  214. 2140  PRINT A$(Z,1);                          'device
  215. 2150   COLOR 7,0
  216. 2160  PRINT ", ";A$(Z,2)                      'description
  217. 2170   IF ST=2 THEN COLOR 15,1 ELSE COLOR 7,0
  218. 2180  LOCATE CSRLIN,11:PRINT A$(Z,5);         'date
  219. 2190   COLOR 7,0
  220. 2200  PRINT ": ";A$(Z,3);" x ";               'quantity
  221. 2210   IF ST=1 THEN COLOR 15,1 ELSE COLOR 7,0
  222. 2220  PRINT A$(Z,4)                           'type
  223. 2230  COLOR 7,0
  224. 2240  PRINT "";
  225. 2250  IF CSRLIN<24 THEN 2280
  226. 2260  GOSUB 2760:CLS
  227. 2270  PRINT
  228. 2280  NEXT Z
  229. 2290  PRINT UL$;
  230. 2300  PRINT "  Date:  ";DATE$
  231. 2310  GOSUB 2760:COLOR 7,0
  232. 2320  VIEW PRINT 3 TO 24:CLS:VIEW PRINT
  233. 2330  CLS:GOTO 780      'return to menu
  234. 2340  '
  235. 2350  '.....edit/delete
  236. 2360  INPUT "ENTER: Sort number.....";Z
  237. 2370  CLS
  238. 2380  PRINT " #";Z;
  239. 2390  LOCATE CSRLIN,9
  240. 2400  PRINT ": ";A$(Z,1);", ";A$(Z,2);" - ";A$(Z,3);" x ";A$(Z,4)
  241. 2410  PRINT TAB(9);": installed ";A$(Z,5)
  242. 2420  PRINT UL$;
  243. 2430  FOR Y=1 TO 5
  244. 2440  PRINT " Line";Y;": ";A$(Z,Y)
  245. 2450  NEXT Y
  246. 2460  PRINT UL$;
  247. 2470  PRINT " Press number in ( ) to:"
  248. 2480  PRINT UL$;
  249. 2490  FOR Y=1 TO 5:PRINT " (";Y;")  Change Line";Y:NEXT Y
  250. 2500  PRINT " ( 6 )  ACCEPT as is"
  251. 2510  PRINT " ( 7 )  DELETE listing"
  252. 2520  PRINT UL$;
  253. 2530  Z$=INKEY$:Q=VAL(Z$):IF Q<1 OR Q>7 THEN 2530
  254. 2540  IF Z$="1"THEN GOSUB 1390:A$(Z,1)=I$:CLS:GOTO 2380
  255. 2550  IF Z$="2"THEN GOSUB 1420:A$(Z,2)=I$:CLS:GOTO 2380
  256. 2560  IF Z$="3"THEN GOSUB 1450:A$(Z,3)=I$:CLS:GOTO 2380
  257. 2570  IF Z$="4"THEN 2630
  258. 2580  IF Z$="5"THEN GOSUB 1670:A$(Z,5)=I$:CLS:GOTO 2380
  259. 2590  IF Z$="6"THEN CLS:GOTO 1240
  260. 2600  IF Z$="7"THEN CLS:GOTO 2660
  261. 2610  GOTO 2530
  262. 2620  '
  263. 2630  VIEW PRINT 9 TO 24:CLS:VIEW PRINT:LOCATE 9
  264. 2640  GOSUB 1480:A$(Z,4)=I$:CLS:GOTO 2380
  265. 2650  '
  266. 2660  '.....delete listing
  267. 2670  LOCATE 13,15:COLOR 15,4
  268. 2680  PRINT " Are you sure you want this listing deleted ?  (y/n) "
  269. 2690  COLOR 7,0
  270. 2700  Z$=INKEY$:IF Z$="n"THEN CLS:GOTO 170
  271. 2710  IF Z$="y"THEN 2720 ELSE 2700
  272. 2720  FOR X=Z TO N:FOR Y=1 TO 5
  273. 2730  A$(X,Y)=A$(X+1,Y):NEXT Y:NEXT X:N=N-1
  274. 2740  CLS:GOTO 1240    'save
  275. 2750  '
  276. 2760  'HARDCOPY
  277. 2770  GOSUB 2880:LOCATE 25,2:COLOR 14,6
  278. 2780  PRINT " Press 1 to print screen, 2 to print screen & ";
  279. 2790  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  280. 2800  Z$=INKEY$:IF Z$="3"THEN GOSUB 2880:RETURN
  281. 2810  IF Z$="1"OR Z$="2"THEN GOSUB 2880:GOTO 2830
  282. 2820  GOTO 2800
  283. 2830  FOR QX=1 TO 24:FOR QY=1 TO 80
  284. 2840  LPRINT CHR$(SCREEN(QX,QY));
  285. 2850  NEXT QY:NEXT QX
  286. 2860  IF Z$="2"THEN LPRINT CHR$(12)
  287. 2870  GOTO 2770
  288. 2880  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  289.